home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / SystemCode / CorePackages / filesetsUtils.tcl < prev    next >
Encoding:
Text File  |  2000-12-22  |  8.1 KB  |  303 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  AlphaTcl - core Tcl engine
  4.  # 
  5.  #  FILE: "filesetsUtils.tcl"
  6.  #                    created: 05/01/2000 {15:08:49 PM} 
  7.  #                   last update: 12/22/2000 {12:02:36 PM} 
  8.  #    
  9.  # ###################################################################
  10.  ##
  11.  
  12.  
  13. ## 
  14.  # -------------------------------------------------------------------------
  15.  #     
  16.  #    "iterateFileset" --
  17.  # 
  18.  #  Utility procedure to iterate over all files in a project, calling some
  19.  #  predefined function '$fn' for each member of project '$proj'.  The
  20.  #  results of such a call are passed to '$resfn' if given.  Finally "done"
  21.  #  is passed to 'resfn'.
  22.  #     
  23.  # -------------------------------------------------------------------------
  24.  ##
  25. proc iterateFileset { proj fn { resfn \# } } {
  26.     global gfileSets gfileSetsType
  27.     eval $resfn "first"
  28.     
  29.     set check [expr {![catch {$gfileSetsType($proj)IterateCheck check}]}]
  30.     
  31.     foreach ff [getFileSet $proj] {
  32.     if { $check && [$gfileSetsType($proj)IterateCheck $proj $ff] } {
  33.         continue
  34.     }
  35.     set res [eval $fn [list $ff]]
  36.     eval $resfn [list $res]
  37.     }
  38.     
  39.     if {$check} {
  40.     catch {$gfileSetsType($proj)IterateCheck done}
  41.     }
  42.     
  43.     eval $resfn "done"
  44.     
  45. }
  46.  
  47. proc filesetRememberOpenClose { file } {
  48.     global fileset_openorclosed
  49.     set fileset_openorclosed [list "$file" [lsearch -exact [winNames -f] $file]]
  50. }
  51.  
  52. proc filesetRevertOpenClose { file } {
  53.     global fileset_openorclosed
  54.     if { [lindex $fileset_openorclosed 0] == "$file" } {
  55.     if { [lindex $fileset_openorclosed 1] < 0 } {
  56.         killWindow
  57.     }
  58.     }    
  59.     catch {unset fileset_openorclosed}
  60. }
  61.  
  62. # ◊◊◊◊ Utils ◊◊◊◊ #
  63.  
  64. proc printFileset { {fset ""}} {
  65.     if {[catch {pickFileset $fset "Print which Fileset?"} fset]} {return}
  66.     foreach f [getFilesInSet $fset] {
  67.     print $f
  68.     }
  69. }
  70.  
  71. proc browseFileset {{fset ""}} {
  72.     global tileLeft tileTop tileWidth errorHeight
  73.     
  74.     if {[catch {pickFileset $fset {Fileset?}} fset]} {return}
  75.     
  76.     foreach f [getFilesInSet $fset] {
  77.     lappend text "\t[file tail $f]\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f"
  78.     }
  79.     new -n "* FileSet '$fset' Browser *" -g $tileLeft $tileTop 200 $errorHeight \
  80.       -m Brws -info "(<cr> to go to file)\r-----\r[join $text \r]"
  81.     select [nextLineStart [nextLineStart [minPos]]] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  82.     message ""
  83. }    
  84.  
  85. proc saveEntireFileset { fset } {
  86.     foreach f [getFilesInSet $fset] {
  87.     if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} { 
  88.         bringToFront $f
  89.         save 
  90.     }
  91.     }
  92. }
  93.  
  94. proc closeEntireFileset { {fset ""} } {
  95.     if {[catch {pickFileset $fset "Close which fileset?"} fset]} {return}
  96.     
  97.     foreach f [getFilesInSet $fset] {
  98.     if {![catch {getWinInfo -w $f arr}]} {
  99.         bringToFront $f
  100.         killWindow
  101.     }
  102.     }
  103. }
  104.  
  105. proc fileToAlpha {f} {
  106.     file::setSig $f ALFA
  107. }
  108.  
  109. proc filesetToAlpha {} {
  110.     if {[catch {pickFileset "" {Convert all files from which fileset?}} fset]} {return}
  111.     iterateFileset $fset fileToAlpha
  112. }
  113.  
  114. proc openEntireFileset {} {
  115.     set fset [pickFileset "" "Open which fileset?"]
  116.     
  117.     # we use our iterator in case there's something special to do
  118.     iterateFileset $fset "edit -c -w"
  119. }
  120.  
  121. proc openFilesetFolder {{fset ""}} {
  122.     global gfileSets
  123.     set fset [pickFileset $fset "Open which fileset's folder?"]
  124.     if {[llength [list $gfileSets($fset)]] == 1 && [file isdirectory [set dir [file dirname $gfileSets($fset)]]]} {
  125.     file::showInFinder $dir
  126.     } else {
  127.     alertnote "Fileset not connected to a folder."
  128.     }
  129. }
  130.  
  131. proc stuffFileset {{fset ""}} {
  132.     global gfileSetsType gfileSets file::separator
  133.     set fset [pickFileset $fset "Which fileset shall I stuff?"]
  134.     if {[string length $fset]} {
  135.     if { $gfileSetsType($fset) == "fromDirectory" && \
  136.       [dialog::yesno "Stuff entire directory?"]} {
  137.         app::launchFore DStf
  138.         sendOpenEvent reply 'DStf' "[file dirname $gfileSets($fset)]${file::separator}"
  139.     } else {            
  140.         app::launchFore DStf
  141.         eval sendOpenEvents 'DStf' [getFilesInSet $fset]
  142.     }        
  143.     sendQuitEvent 'DStf'
  144.     }
  145. }
  146.  
  147. proc wordCountFileset {{fset ""}} {
  148.     global currFileSet
  149.     if {![string length $fset]} { set fset $currFileSet }
  150.     iterateFileset $fset wordCountProc filesetUtilWordCount
  151. }
  152.  
  153. proc filesetUtilWordCount {count} {
  154.     global fs_ccount fs_wcount fs_lcount
  155.     switch $count {
  156.     "first" {
  157.         set fs_ccount 0
  158.         set fs_wcount 0
  159.         set fs_lcount 0
  160.     }       
  161.     "done" {
  162.         alertnote "There were $fs_ccount lines, $fs_wcount words and $fs_lcount chars"
  163.         unset fs_ccount fs_wcount fs_lcount
  164.     }
  165.     default {
  166.         incr fs_ccount [lindex $count 2]
  167.         incr fs_wcount [lindex $count 1]
  168.         incr fs_lcount [lindex $count 0]
  169.     }
  170.     }
  171. }
  172.  
  173.  
  174. ## 
  175.  # -------------------------------------------------------------------------
  176.  # 
  177.  # "wordCountProc" --
  178.  # 
  179.  #  Completely new proc which does the same as the old one
  180.  #  without opening lots of windows.
  181.  #  *Very* memory comsuming for large files, though.
  182.  #  But I think the old one was equally memory consuming.
  183.  #  
  184.  #  Ok, this is not exactly a bug fix. It's a IMHO better option.
  185.  #  
  186.  # -------------------------------------------------------------------------
  187.  ##
  188.  
  189. proc wordCountProc {file} {
  190.     message "Counting [file tail $file]…"
  191.     set fid [alphaOpen $file r]
  192.     set filecont [read $fid]
  193.     close $fid
  194.     if {[regexp {\n\r} $filecont]} {
  195.     set newln "\n\r"
  196.     } elseif {[regexp {\n} $filecont]} {
  197.     set newln "\n"
  198.     } else {
  199.     set newln "\r"
  200.     }
  201.     set lines [expr {[regsub -all -- $newln $filecont " " filecont] + 1}]
  202.     set chars [string length $filecont]
  203.     regsub -all {[!=;.,\(\#\=\):\{\"\}]} $filecont " " filecont
  204.     set words [llength $filecont]
  205.     return "$chars $words $lines"
  206. }
  207.  
  208.  
  209. # ◊◊◊◊ From search dialog ◊◊◊◊ #
  210.  
  211. proc findNewFileset {} {
  212.     return [newFileset]
  213. }
  214.  
  215.  
  216. proc findNewDirectory {} {
  217.     global gfileSets currFileSet gfileSetsType gDirScan
  218.     
  219.     set dir [get_directory -p "Scan which folder?"]
  220.     if {![string length $dir]} return
  221.     
  222.     set filePat {*}
  223.     set name [file tail $dir]
  224.     
  225.     set gfileSets($name) [file join $dir $filePat]
  226.     set gDirScan($name) 1
  227.     set gfileSetsType($name) "fromDirectory"
  228.     set currFileSet $name
  229.     updateCurrentFileset
  230.     return $name
  231. }
  232.  
  233. ## 
  234.  # -------------------------------------------------------------------------
  235.  # 
  236.  # "replaceInFileset" --
  237.  # 
  238.  #  Quotes things correctly so searches work, and adds a check on
  239.  #  whether there are any windows.
  240.  #  
  241.  #  This procedure is a little obsolete, given what's in the supersearch
  242.  #  package.  However some people may find it useful.
  243.  # -------------------------------------------------------------------------
  244.  ##
  245. proc replaceInFileset {} {
  246.     global gfileSets win::NumDirty
  247.     set how [dialog::optionMenu "Search type:" \
  248.       [list "Textual replace" "Case-independent textual replace" \
  249.       "Regexp replace" "Case-independent regexp replace"] "" 1]
  250.     set from [prompt "Search string:" [searchString]]
  251.     searchString $from
  252.     if {$how < 2} {set from [quote::Regfind $from]}
  253.     
  254.     set to [prompt "Replace string:" [replaceString]]
  255.     replaceString $to
  256.     if {$how < 2} {set to [quote::Regsub $to]}
  257.     if {[catch {regsub -- $from "$from" $to dummy} err]} {
  258.     alertnote "Regexp compilation problems: $err"
  259.     return
  260.     }
  261.     set fsets [pickFileset "" "Which filesets?" "multilist"]
  262.     
  263.     if {${win::NumDirty}} {
  264.     if {[buttonAlert "Save all windows?" "Yes" "Cancel"] != "Yes"} return
  265.     saveAll
  266.     }
  267.     
  268.     set cid [scancontext create]
  269.     set changes 0
  270.     if {$how & 1} {
  271.     set case "-nocase"
  272.     } else {
  273.     set case "--"
  274.     }
  275.     
  276.     scanmatch $case $cid $from {set matches($f) 1 ;incr changes}
  277.     foreach fset $fsets {
  278.     foreach f [getFileSet $fset] {
  279.         if {![catch {set fid [alphaOpen $f]}]} {
  280.         message "Looking at '[file tail $f]'"
  281.         scanfile $cid $fid
  282.         close $fid
  283.         }
  284.     }
  285.     }
  286.     
  287.     scancontext delete $cid
  288.     
  289.     foreach f [array names matches] {
  290.     message "Modifying ${f}…"
  291.     set cid [alphaOpen $f "r"]
  292.     if {[regsub -all $case $from [read $cid] $to out]} {
  293.         set ocid [alphaOpen $f "w+"]
  294.         puts -nonewline $ocid $out
  295.         close $ocid
  296.     }
  297.     close $cid
  298.     }
  299.     
  300.     eval file::revertThese [array names matches]
  301.     message "Replaced $changes instances"
  302. }
  303.